perm filename SAIDIS.SAI[SYS,HE] blob sn#084266 filedate 1974-01-28 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002	SAIDIS - display-routines and the line-editor
C00008 00003	_ global storage
C00010 00004	_ UPDPTR, BUFPTR, CALCMP, INTX, INTY, TRANSUP, ALINE
C00016 00005	_ DPSTR, DIRIND, PRECAL, CALC
C00018 00006	_ FRAME, SEDGE
C00022 00007	_ MEDGE, SLINES, MLINES
C00025 00008	_ MVERT, UPPDAT
C00027 00009	_ LINED
C00029 00010	_ LINED - line editor command decoding
C00032 00011	_ LINED - more line editor command decoding
C00034 00012	_ LINED - more line editor command decoding
C00036 ENDMK
C⊗;
COMMENT SAIDIS - display-routines and the line-editor;

ENTRY TRANSUP,ALINE,DPSTR,DIRIND,PRECAL,CALC,UPDPTR,BUFPTR,FRAME,
      SEDGE,MEDGE,SLINES,MLINES,MVERT,UPPDAT,LINED;

BEGIN "SAIDIS"

REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;

DEFINE CL="'15&'12",
	_="COMMENT",
	QRETURN="BEGIN UNTELL; RETURN END",
	LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
	QI="INTEGER",
	QFOP="FORWARD INTERNAL SIMPLE PROCEDURE",
	QEP="EXTERNAL SIMPLE PROCEDURE",
	QS="STRING",
	QIA="INTEGER ARRAY",
	QESP="EXTERNAL SIMPLE STRING PROCEDURE",
	QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
	NUMI="CVD(QREAD)",
	QERP="EXTERNAL SIMPLE REAL PROCEDURE",
	QRI="REFERENCE INTEGER",
	QR="REAL",
	QRR="REFERENCE REAL",
	UPDJMP(I)="DISBUF[BUFPTR]←((DADR[I+1]+III) LSH 18) LOR '20",
	BELCRE(ICV)="LVNEXT(ICV,-1)",
	SAFEX="SAFE";
_ global storage;

SAFEX INTEGER ARRAY CV,LN[0:1];
SAFEX REAL ARRAY XX,YY[0:1];

EXTERNAL STRING H,NAME,LIEXT;

INTEGER EM, XC, YC;

EXTERNAL REAL IRX, IRY, ISCX, ISCY;

EXTERNAL INTEGER IA,IB,IC,ID,IE,IG,WHERE,BRCHAR,NGRF,CVLIN,NOEPA,NOL,
	MAXNOL,NOBAL,MAXNOV,LDATE,LNCRE1,LNCRE2,MODE,LOCB,LOCT,WIND,
	DHOLD,IAEDG,NOLS,X,Y,DISLAS,DISFUS,PLT,NODIS,DFORCE,III,DRX, DRY,
	FRAME;

SAFEX EXTERNAL INTEGER ARRAY DICH,DION,DISP,DADR,DBRSI[0:15],
	LE,LCREDE,LVERCO,LVER,DISBUF[1:1];

SAFEX EXTERNAL REAL ARRAY EAX,EAY,EBX,EBY,XVCOR,YVCOR,XLCOR,YLCOR,
	ANGARG[1:1];


	QEIP LACT(QI I);
	QEIP ISIGN(QI I,J);
	QEP TELL(QS S);
	QEP UNTELL;
	QESP QREAD;
	QEIP LVNEXT(QI I,J);
	QEIP QSET(QRI I);
	QEIP LINCHA(QI I,J,K);
	QEP SKAR1(QR X1,Y1,X2,Y2; QI LL; QRR X,Y,RSQ);
	QEP PLDIS(QR X,Y; QI I; QRR XL,YL,R; QRI IW);
	QEIP LSPLIT(QI I; QR A,B);
	QEIP MSCVCO(QI I,J,K);
	QEIP LINSRT(QI I,J; QR A,B,C,D; QI K,L);
	QEIP MERCV(QI I,J,K);
	QFOP UPPDAT;
	QEIP DISX(QR X);
	QEIP DISY(QR Y);
	QEIP LCRL(QI I);
	QEIP LINDEL(QI I,J);
_ UPDPTR, BUFPTR, CALCMP, INTX, INTY, TRANSUP, ALINE;

_ Updates DPYPTR before creating a pog.;

INTERNAL SIMPLE PROCEDURE UPDPTR(INTEGER POG);
	BEGIN "UPDPTR"
	DPYPTR←'700000000 LOR (DISFUS+DADR[POG]);
	DISBUF[DADR[POG]]←DBRSI[POG]
	END "UPDPTR";

_ Returns index+1 for the word in DISBUF, to which DPYPTR is currently pointing;

INTERNAL SIMPLE INTEGER PROCEDURE BUFPTR;
	RETURN((DPYPTR LAND '777777)-DISFUS+1);

_ Outputs display buffer BUFR to disk file FILE in a format
readable by the Nealy Calcomp plotter program PLTVEC, and by
the Quam Video Synthesizer program MIRTOP;

SIMPLE PROCEDURE CALCMP(STRING FILE; SAFE INTEGER ARRAY BUFR);
	IF FILE THEN
		BEGIN INTEGER DSIZ,CCCHN;
		OPEN(CCCHN←GETCHAN,"DSK",'14,0,1,0,0,0);
		ENTER(CCCHN,FILE&".GRF",0);
		DPYPARS;DSIZ←BUFR[2]+3;
		ARRYOUT(CCCHN,BUFR[1],DSIZ);
		RELEASE(CCCHN);
		END "CALCMP";

_	Transforms X and Y-coordinates from display to internal.;

SIMPLE REAL PROCEDURE INTX(INTEGER X);
	RETURN(IRX+ISCX*(X-DRX));

SIMPLE REAL PROCEDURE INTY(INTEGER Y);
	RETURN(IRY+ISCY*(Y-DRY));

_ For updating display in case of changes in scale and/or origin;

INTERNAL SIMPLE PROCEDURE TRANSUP;
	BEGIN "TRANSUP"
	DICH[0]←1;
	UPPDAT
	END "TRANSUP";

_ For display of lines. Has optional windowing feature;

INTERNAL SIMPLE PROCEDURE ALINE(INTEGER X1,Y1,X2,Y2);
	IF ¬WIND∨(-512≤X1≤512∧-512≤X2≤512∧LOCT+5≤Y1≤510∧LOCT+5≤Y2≤510) THEN
		BEGIN AIVECT(X1,Y1); AVECT(X2,Y2); RETURN END;
_ DPSTR, DIRIND, PRECAL, CALC;

_ For displaying a string at (X,Y) with windowing feature;

INTERNAL SIMPLE PROCEDURE DPSTR(INTEGER X,Y; STRING S);
	BEGIN "DPSTR"
	IF WIND∧¬(-510≤X≤500∧((LOCT+5) MAX -510)≤Y≤500) THEN RETURN;
	EM←EM+1;
	AIVECT(X,Y);
	DISBUF[DPYPTR LAND '777777 - DISFUS + 1]←1;
	DPYSST(S)
	END "DPSTR";


_ Indicates one of four quadrants, depending on ANGLE;

INTERNAL SIMPLE INTEGER PROCEDURE DIRIND(REAL ANGLE);
	RETURN(1+ANGLE/90.);


_ IB receives the count of the number of display words to be displayed;

INTERNAL SIMPLE PROCEDURE PRECAL;
	BEGIN "PRECAL"
	IA←4;
	IB←3;
	WHILE IA≤DISLAS+2 DO
		IF DISBUF[IA] LAND '777777='20 THEN
		IA←(DISBUF[IA] LSH -18)-III ELSE
		BEGIN IA←IA+1; IB←IB+1 END
	END "PRECAL";


_ Service routine for plotting displays;

INTERNAL PROCEDURE CALC;
	BEGIN "CALC"
	INTEGER ARRAY ARR[1:IB];
	IA←IC←1;
	WHILE IA≤DISLAS DO
	    IF DISBUF[IA] LAND '777777='20 THEN IA←(DISBUF[IA] LSH -18)-III
		ELSE BEGIN ARR[IC]←DISBUF[IA]; IA←IA+1; IC←IC+1 END;
	ARR[2]←IB-3;
	CALCMP(NAME&NGRF,ARR);
	OUTSTR("PLOT ON "&NAME&NGRF&CL);
	NGRF←NGRF+1
	END "CALC";
_ FRAME, SEDGE;

_ Displays a frame for the scene;

SIMPLE PROCEDURE FRAM;
	BEGIN "FRAME"
	INTEGER X1,Y1,X2,Y2;
	UPDPTR(1);
	X1←DISX(0.);
	Y1←DISY(0.);
	X2←DISX(310.);
	Y2←DISY(240.);
	ALINE(X1,Y1,X2,Y1);
	ALINE(X2,Y1,X2,Y2);
	ALINE(X2,Y2,X1,Y2);
	ALINE(X1,Y2,X1,Y1)
	END "FRAME";


_ Displays the edges. Has optional windowing facilities;

INTERNAL SIMPLE PROCEDURE SEDGE;
	BEGIN "SEDGE"
	EXTERNAL SIMPLE PROCEDURE PNTS;
	UPDPTR(2);
	IF EAX[1]+EAY[1]≠0. THEN
		BEGIN
		AIVECT(IE←0,IG←0);
		PNTS;
		END;
	UPDJMP(2)
	END "SEDGE";
_ MEDGE, SLINES, MLINES;

_ Marks first visible 100 edge-pairs. Windowing optional;

INTERNAL SIMPLE PROCEDURE MEDGE;
	BEGIN "MEDGE"
	UPDPTR(3);
	EM←0;
	LOOP(IB,1,NOEPA,1) IF EM<100 THEN
		DPSTR(DISX(0.5*(EAX[IB]+EBX[IB])),
		      DISY(0.5*(EAY[IB]+EBY[IB])),
		      (IF LE[IB]=2∨LE[IB]=4 THEN "-" ELSE NULL)&
		       CVS(IB)&(IF LE[IB]≥3 THEN "-" ELSE NULL));
   	UPDJMP(3)
	END "MEDGE";


_ Displays line-drawing (only active lines);

INTERNAL SIMPLE PROCEDURE SLINES;
	BEGIN "SLINES"
	EXTERNAL SIMPLE PROCEDURE LNES;
	UPDPTR(4);
	LNES;
	UPDJMP(4)
	END "SLINES";


_ Marks the active lines on the display.;

INTERNAL SIMPLE PROCEDURE MLINES;
	BEGIN "MLINES"
	INTEGER I1,I2;
	UPDPTR(5);
	LOOP(I1,1,MAXNOL,1) IF LACT(I1) THEN
		DPSTR(DISX(0.5*(XLCOR[(I2←2*I1)-1]+XLCOR[I2])),
		      DISY(0.5*(YLCOR[I2-1]+YLCOR[I2]))+5,
		       (IF(I2←DIRIND(ANGARG[I1]))≤2 THEN "+" ELSE "-")&
		       (IF I2=1∨I2=4 THEN "L" ELSE CVS(I1))&
		       (IF I2=1∨I2=4 THEN CVS(I1) ELSE "L"));
	UPDJMP(5)
	END "MLINES";
_ MVERT, UPPDAT;
_ Marks compound vertices of active lines.;

INTERNAL SIMPLE PROCEDURE MVERT;
	BEGIN "MVERT"
	UPDPTR(6);
	LOOP(IB,1,MAXNOV,1) IF BELCRE(IB)
		THEN DPSTR(DISX(XVCOR[IB]),DISY(YVCOR[IB]),"V"&CVS(IB));
	UPDJMP(6)
	END "MVERT";

_ Updates the central display array if necessary, does DPYOUT if wanted.;

INTERNAL SIMPLE PROCEDURE UPPDAT;
	BEGIN "UPPDAT"
	INTEGER CHANGE,IA;
	LOCT←(DISY(0.)-30) MAX -420;
	LOCB←-510;
	TYPLOC(LOCT,LOCB);
	IF ¬DFORCE∧(NODIS∨DHOLD∨¬(NOEPA+NOL)) THEN RETURN;
	TELL("display update");
	CHANGE←0;
	IF DICH[0] THEN LOOP(IA,1,14,1) DICH[IA]←1;
	LOOP(IA,1,6,1) IF ¬DISP[IA] THEN 
		BEGIN
		DISBUF[DADR[IA]]←((DADR[IA+1]+III) LSH 18) LOR '20;
		IF DION[IA] THEN CHANGE←1;
		DION[IA]←0
		END ELSE IF ¬DICH[IA] THEN BEGIN
		IF ¬DION[IA] THEN
			BEGIN
			DISBUF[DADR[IA]]←DBRSI[IA];
			DION[IA]←1;
			CHANGE←1
			END
		END ELSE BEGIN
		DION[IA]←CHANGE←1;
		DICH[IA]←0;
		CASE IA OF
			BEGIN
			;
			FRAM;
			SEDGE;
			MEDGE;
			SLINES;
			MLINES;
			MVERT
			END
		END;
	DPYPTR←'700000000 LOR (DISFUS+DISLAS);
	IF DFORCE∨CHANGE∧¬PLT THEN
		BEGIN
		HYDPOG(FRAME);
		FRAME←GETPOG;
		DPYOUT(FRAME);
		END;
	DICH[0]←0;
	UNTELL
	END "UPPDAT";
_ LINED;

_  The line-editing program;

INTERNAL SIMPLE PROCEDURE LINED;
	BEGIN "LINED"
	LABEL COMND,DEL,DEL1,OUT1,DEL2,LCH,INS,INS1,INS2,INS3,INS4,
		INS5,INS6,DET,DIS,SETT,LCR,ATT,PER,TEM,MER,SVB,EXPD,
		INS7,INS8,DIS1,DIS2;
	INTEGER IB,LL,IDAT,NEWD,ISV,ICV,LADD,IA,N1,N2,IC,IDIS,ITAG,ID,INA;
	REAL RX,RY,RS,R,RXS,RYS,X2,Y2;
	PRELOAD_WITH "E","DEL","INS","DET","DIS","SET","LCR",
		     "ATT","PER","TEM","MER";
	OWN SAFE STRING ARRAY COMS[0:10];

	IF WHERE≠1 THEN
		BEGIN
		IA←WHERE;
		WHERE←1;
		CASE IA OF BEGIN ; ; ; ; ; GO INS6; GO INS8 END
		END;
	TELL("line-editor");
	X←DISX(10.);
	Y←DISY(10.);
	NOLS←NOL;
COMND:	OUTSTR(CL&"→");
	INA←LN[0]←LN[1]←LL←IDAT←NEWD←ISV←ICV←LADD←0;
	IB←1;
	H←(IF MODE THEN QREAD ELSE TTYINL(13,BRCHAR));
	IA←0;
	WHILE IA<11∧¬EQU(H,COMS[IA]) DO IA←IA+1;
	IF IA=11 THEN BEGIN OUTSTR("?"); GO COMND END;
	CASE IA OF BEGIN
		GO OUT1;
		GO DEL;
		GO INS;
		GO DET;
		GO DIS;
		GO SETT;
		GO LCR;
		GO ATT;
		GO PER;
		GO TEM;
		GO MER
		END;
_ LINED - line editor command decoding;

DEL:	H←QREAD;
	IF ¬EQU(H,"LD") THEN GO DEL2;
	N1←NUMI;
	N2←(IF BRCHAR=":" THEN NUMI ELSE N1);
DEL1:	LOOP(IA,1,MAXNOL,1) IF LCREDE[IA]≥0∧(INA∧¬LACT(IA)∨¬INA∧
		(ID←LCRL(IA))≥N1∧ID≤N2) THEN LINDEL(IA,0);
	GO DIS2;

DEL2:	IF EQU(H,"ALL") THEN BEGIN LL←-1; GO LCH END;
	IF EQU(H,"ACT") THEN BEGIN N1←LNCRE1; N2←LNCRE2; GO DEL1 END;
	IF EQU(H,"INA") THEN BEGIN INA←1; GO DEL1 END;
	LL←CVD(H);
LCH:	LINCHA(LL,IDAT,NEWD);
	GO DIS2;

INS:	IA←-1;
INS1:	H←QREAD;
	IA←IA+1;
	ITAG←0;
	CV[IA]←0;
	IF EQU(H,"@") THEN BEGIN N1←NUMI; GO INS4 END;
	IF EQU(H,"A") THEN BEGIN X←NUMI; Y←NUMI; GO INS5 END;
	IF EQU(H,"R") THEN BEGIN X←XC+NUMI; Y←YC+NUMI; GO INS5 END;
	IF EQU(H,".") THEN BEGIN X←XC; Y←YC; GO INS5 END;
	N1←ABS(N2←CVD(H));
	CV[IA]←ISIGN(LVERCO[N1],N2);
INS4:	X←DISX(XVCOR[LVERCO[N1]]);
	Y←DISY(YVCOR[LVERCO[N1]]);
	IF BRCHAR="*" THEN BEGIN X←X+NUMI; Y←Y+NUMI END;
	GO INS2;

INS5:	IF BRCHAR='12 THEN GO INS3;
	H←QREAD;
	IF ¬(EQU(H,"LA")∧IC←1)∧¬(EQU(H,"L")∧¬(IC←0)) THEN GO INS3;
	RS←900000.;
	X2←INTX(X);
	Y2←INTY(Y);
	LOOP(N1,1,MAXNOL,1) IF LACT(N1) THEN
		BEGIN
		IF -IA THEN
			BEGIN
			PLDIS(X2,Y2,N1,RX,RY,R,N2);
			IF N2 THEN R←900000.
			END ELSE SKAR1(XX[0],YY[0],X2,Y2,N1,RX,RY,R);
		IF R<RS THEN BEGIN RXS←RX; RYS←RY; RS←R; LN[IA]←N1*IC END
		END;
	IF RS=900000. THEN BEGIN OUTSTR("NO LINE FOUND"); GO COMND END;
	X←DISX(XX[IA]←RXS);
	Y←DISY(YY[IA]←RYS);
	ITAG←1;
_ LINED - more line editor command decoding;

INS2:	IF ¬IA THEN H←QREAD;
INS3:	IF ¬ITAG THEN BEGIN XX[IA]←INTX(X); YY[IA]←INTY(Y) END;
	IF ¬IA THEN IF EQU(H,"→") THEN BEGIN XC←X; YC←Y; GO INS1 END
		  ELSE BEGIN OUTSTR("?"); GO COMND END;

INS6:	N1←LINSRT(CV[0],CV[1],XX[0],YY[0],XX[1],YY[1],LDATE,0);
	IF N1≤0 THEN GO INS7;
	OUTSTR("NEW LINE: "&CVS(N1));
	XC←X;
	YC←Y;
INS8:	LOOP(IA,0,1,1) IF (IB←LN[IA]) THEN
		BEGIN
		N2←LSPLIT(IB,XX[IA],YY[IA]);
		IF ¬N2 THEN BEGIN WHERE←6; GO EXPD END;
		MSCVCO(2*IB+IA-1,N2,1);
		LN[IA]←0
		END;
	GO DIS2;

INS7:	IF N1≠-1 THEN
		BEGIN
		OUTSTR("LINE TOO SHORT OR TOPOLOGICALLY IMPOSSIBLE");
		GO COMND
	        END;

	_ *** Here it is necessary to expand line-space ***;

	WHERE←5;
EXPD:	NOBAL←NOL;
	TELL("expanding");
	RETURN;

	_ *** *** *** *** *** ***   *** *** *** *** *** ***;

DET:	LADD←0;
	ISV←NUMI;
	GO SVB;

ATT:	LADD←1;
	ISV←NUMI;
	ICV←NUMI;
SVB:	MSCVCO(ISV,ICV,LADD);
	IF CVLIN THEN GO DIS2 ELSE GO COMND;

PER:	ISV←NUMI;
	LVER[ISV]←ABS LVER[ISV];
	GO COMND;
_ LINED - more line editor command decoding;

TEM:	ISV←NUMI;
	LVER[ISV]←-(ABS LVER[ISV]);
	GO COMND;

LCR:	H←QREAD;
	IF EQU(H,"LD") THEN
		BEGIN
		N1←NUMI;
		N2←NUMI;
		LOOP(IA,1,MAXNOL,1) IF LCRL(IA)=N1 THEN LINDEL(IA,N2);
		GO DIS2
		END;
	N1←CVD(H);
	N2←(IF BRCHAR=":" THEN NUMI ELSE N1);
	IA←NUMI;
	LOOP(ISV,N1,N2,1) LINDEL(ISV,IA);
	GO DIS2;

MER:	MERCV(LVERCO[NUMI],LVERCO[NUMI],0);
	DICH[6]←1;
	IF CVLIN THEN DICH[4]←1;
	IF IDIS THEN GO DIS1 ELSE GO COMND;

SETT:	H←QREAD;
	IF EQU(H,"LDATE") THEN BEGIN QSET(LDATE); GO COMND END;
	IF EQU(H,"LNCRE") THEN BEGIN QSET(LNCRE1);QSET(LNCRE2);GO DIS2 END;
	IF EQU(H,"CVLIN") THEN
		BEGIN
		QSET(CVLIN);
		DICH[4]←1;
		IF IDIS THEN GO DIS1 ELSE GO COMND
 	        END;
	OUTSTR("?");
	GO COMND;

DIS:	IF BRCHAR≠'12 THEN IDIS←NUMI;
DIS1:	UPPDAT;
	GO COMND;

DIS2:	DICH[4]←DICH[5]←DICH[6]←1;
	LIEXT←".TEM";
	IF IDIS THEN GO DIS1 ELSE GO COMND;

OUT1:	IF ¬IDIS THEN UPPDAT;
	UNTELL
	END "LINED";

END "SAIDIS"; _ END OF SAIDIS;